home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor11a.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  11KB  |  428 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor11a;
  9.  
  10. uses Memory, TutConst, Drivers, Objects, Views, Menus, App, Dialogs,
  11.   Editors, StdDlg, Validate;
  12.  
  13. type
  14.   POrder = ^TOrder;
  15.   TOrder = record
  16.     OrderNum: string[8];
  17.     OrderDate: string[8];
  18.     StockNum: string[8];
  19.     Quantity: string[5];
  20.     Payment, Received, MemoLen: Word;
  21.     MemoText: array[0..255] of Char;
  22.   end;
  23.  
  24.   POrderObj = ^TOrderObj;
  25.   TOrderObj = object(TObject)
  26.     TransferRecord: TOrder;
  27.     constructor Load(var S: TStream);
  28.     procedure Store(var S: TStream);
  29.   end;
  30.  
  31.   POrderWindow = ^TOrderWindow;
  32.   TOrderWindow = object(TDialog)
  33.     constructor Init;
  34.     destructor Done; virtual;
  35.     procedure HandleEvent(var Event: TEvent); virtual;
  36.   end;
  37.  
  38.   TTutorApp = object(TApplication)
  39.     ClipboardWindow: PEditWindow;
  40.     OrderWindow: POrderWindow;
  41.     constructor Init;
  42.     destructor Done; virtual;
  43.     procedure DoAboutBox;
  44.     procedure HandleEvent(var Event: TEvent); virtual;
  45.     procedure InitMenuBar; virtual;
  46.     procedure InitStatusLine; virtual;
  47.     procedure LoadDesktop;
  48.     procedure NewWindow;
  49.     procedure OpenOrderWindow;
  50.     procedure OpenWindow;
  51.     procedure SaveDesktop;
  52.     procedure SaveOrderData;
  53.     procedure ShowOrder(AOrderNum: Integer);
  54.   end;
  55.  
  56. var
  57.   ResFile: TResourceFile;
  58.   OrderInfo: TOrder;
  59.   OrderColl: PCollection;
  60.   CurrentOrder: Integer;
  61.  
  62. const
  63.   ROrderObj: TStreamRec = (
  64.      ObjType: 15000;
  65.      VmtLink: Ofs(TypeOf(TOrderObj)^);
  66.      Load:    @TOrderObj.Load;
  67.      Store:   @TOrderObj.Store
  68.   );
  69.   ROrderWindow: TStreamRec = (
  70.      ObjType: 15001;
  71.      VmtLink: Ofs(TypeOf(TOrderWindow)^);
  72.      Load:    @TOrderWindow.Load;
  73.      Store:   @TOrderWindow.Store
  74.   );
  75.  
  76. procedure TutorStreamError(var S: TStream); far;
  77. var
  78.   ErrorMessage: String;
  79. begin
  80.   case S.Status of
  81.     stError: ErrorMessage := 'Stream access error';
  82.     stInitError: ErrorMessage := 'Cannot initialize stream';
  83.     stReadError: ErrorMessage := 'Read beyond end of stream';
  84.     stWriteError: ErrorMessage := 'Cannot expand stream';
  85.     stGetError: ErrorMessage := 'Unregistered type read from stream';
  86.     stPutError: ErrorMessage := 'Unregistered type written to stream';
  87.     end;
  88.   DoneVideo;
  89.   PrintStr('Error: ' + ErrorMessage);
  90.   Halt(S.Status);
  91. end;
  92.  
  93. procedure LoadOrders;
  94. var
  95.   OrderFile: TBufStream;
  96. begin
  97.   OrderFile.Init('ORDERS.DAT', stOpenRead, 1024);
  98.   OrderColl := PCollection(OrderFile.Get);
  99.   OrderFile.Done;
  100. end;
  101.  
  102. procedure SaveOrders;
  103. var
  104.   OrderFile: TBufStream;
  105. begin
  106.   OrderFile.Init('ORDERS.DAT', stOpenWrite, 1024);
  107.   OrderFile.Put(OrderColl);
  108.   OrderFile.Done;
  109. end;
  110.  
  111. constructor TOrderObj.Load(var S: TStream);
  112. begin
  113.   inherited Init;
  114.   S.Read(TransferRecord, SizeOf(TransferRecord));
  115. end;
  116.  
  117. procedure TOrderObj.Store(var S: TStream);
  118. begin
  119.   S.Write(TransferRecord, SizeOf(TransferRecord));
  120. end;
  121.  
  122. constructor TOrderWindow.Init;
  123. var
  124.   R: TRect;
  125.   Field: PInputLine;
  126.   Cluster: PCluster;
  127.   Memo: PMemo;
  128. begin
  129.   R.Assign(0, 0, 60, 17);
  130.   inherited Init(R, 'Orders');
  131.   Options := Options or ofCentered;
  132.   HelpCtx := $F000;
  133.  
  134.   R.Assign(13, 2, 23, 3);
  135.   Field := New(PInputLine, Init(R, 8));
  136.   Field^.SetValidator(New(PRangeValidator, Init(1, 99999)));
  137.   Insert(Field);
  138.   R.Assign(2, 2, 12, 3);
  139.   Insert(New(PLabel, Init(R, '~O~rder #:', Field)));
  140.  
  141.   R.Assign(43, 2, 53, 3);
  142.   Field := New(PInputLine, Init(R, 8));
  143.   Field^.SetValidator(New(PPXPictureValidator,
  144.     Init('{#[#]}/{#[#]}/{##[##]}', True)));
  145.   Insert(Field);
  146.   R.Assign(26, 2, 41, 3);
  147.   Insert(New(PLabel, Init(R, '~D~ate of order:', Field)));
  148.  
  149.   R.Assign(13, 4, 23, 5);
  150.   Field := New(PInputLine, Init(R, 8));
  151.   Field^.SetValidator(New(PPXPictureValidator, Init('&&&-####', True)));
  152.   Insert(Field);
  153.   R.Assign(2, 4, 12, 5);
  154.   Insert(New(PLabel, Init(R, '~S~tock #:', Field)));
  155.  
  156.   R.Assign(46, 4, 53, 5);
  157.   Field := New(PInputLine, Init(R, 5));
  158.   Field^.SetValidator(New(PRangeValidator, Init(1, 99999)));
  159.   Insert(Field);
  160.   R.Assign(26, 4, 44, 5);
  161.   Insert(New(PLabel, Init(R, '~Q~uantity ordered:', Field)));
  162.  
  163.   R.Assign(3, 7, 57, 8);
  164.   Cluster := New(PRadioButtons, Init(R,
  165.     NewSItem('Cash   ',
  166.     NewSItem('Check  ',
  167.     NewSItem('P.O.   ',
  168.     NewSItem('Account', nil))))));
  169.   Insert(Cluster);
  170.   R.Assign(2, 6, 21, 7);
  171.   Insert(New(PLabel, Init(R, '~P~ayment method:', Cluster)));
  172.  
  173.   R.Assign(22, 8, 37, 9);
  174.   Cluster := New(PCheckBoxes, Init(R, NewSItem('~R~eceived', nil)));
  175.   Insert(Cluster);
  176.  
  177.   R.Assign(3, 10, 57, 13);
  178.   Memo := New(PMemo, Init(R, nil, nil, nil, 255));
  179.   Insert(Memo);
  180.   R.Assign(2, 9, 9, 10);
  181.   Insert(New(PLabel, Init(R, 'Notes:', Memo)));
  182.  
  183.   R.Assign(2, 14, 12, 16);
  184.   Insert(New(PButton, Init(R, '~N~ew', cmOrderNew, bfNormal)));
  185.   R.Assign(13, 14, 23, 16);
  186.   Insert(New(PButton, Init(R, '~S~ave', cmOrderSave, bfDefault)));
  187.   R.Assign(24, 14, 34, 16);
  188.   Insert(New(PButton, Init(R, 'Re~v~ert', cmOrderCancel, bfNormal)));
  189.   R.Assign(35, 14, 45, 16);
  190.   Insert(New(PButton, Init(R, 'Next', cmOrderNext, bfNormal)));
  191.   R.Assign(46, 14, 56, 16);
  192.   Insert(New(PButton, Init(R, 'Prev', cmOrderPrev, bfNormal)));
  193.   SelectNext(False);
  194. end;
  195.  
  196. destructor TOrderWindow.Done;
  197. begin
  198.   DisableCommands([cmOrderNext, cmOrderPrev, cmOrderSave]);
  199.   inherited Done;
  200. end;
  201.  
  202. procedure TOrderWindow.HandleEvent(var Event: TEvent);
  203. begin
  204.   inherited HandleEvent(Event);
  205.   if (Event.What = evBroadcast) and
  206.     (Event.Command = cmFindOrderWindow) then
  207.     ClearEvent(Event);
  208. end;
  209.  
  210. constructor TTutorApp.Init;
  211. var
  212.   R: TRect;
  213. begin
  214.   MaxHeapSize := 8192;
  215.   EditorDialog := StdEditorDialog;
  216.   StreamError := @TutorStreamError;
  217.   RegisterMenus;
  218.   RegisterObjects;
  219.   RegisterViews;
  220.   RegisterApp;
  221.   RegisterEditors;
  222.   RegisterDialogs;
  223.   RegisterValidate;
  224.   RegisterType(ROrderObj);
  225.   RegisterType(ROrderWindow);
  226.   ResFile.Init(New(PBufStream, Init('TUTORIAL.TVR', stOpenRead, 1024)));
  227.   inherited Init;
  228.   DisableCommands([cmStockWin, cmSupplierWin]);
  229.   Desktop^.GetExtent(R);
  230.   ClipboardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  231.   if ValidView(ClipboardWindow) <> nil then
  232.   begin
  233.     ClipboardWindow^.Hide;
  234.     InsertWindow(ClipboardWindow);
  235.     Clipboard := ClipboardWindow^.Editor;
  236.     Clipboard^.CanUndo := False;
  237.   end;
  238.   LoadOrders;
  239.   CurrentOrder := 0;
  240.   OrderInfo := POrderObj(OrderColl^.At(CurrentOrder))^.TransferRecord;
  241.   DisableCommands([cmOrderNext, cmOrderPrev, cmOrderCancel, cmOrderSave]);
  242. end;
  243.  
  244. destructor TTutorApp.Done;
  245. begin
  246.   ResFile.Done;
  247.   inherited Done;
  248. end;
  249.  
  250. procedure TTutorApp.DoAboutBox;
  251. begin
  252.   ExecuteDialog(PDialog(ResFile.Get('ABOUTBOX')), nil);
  253. end;
  254.  
  255. procedure TTutorApp.HandleEvent(var Event: TEvent);
  256. var
  257.   R: TRect;
  258. begin
  259.   inherited HandleEvent(Event);
  260.   if Event.What = evCommand then
  261.   begin
  262.     case Event.Command of
  263.       cmOrderSave:
  264.         begin
  265.           SaveOrderData;
  266.           ClearEvent(Event);
  267.         end;
  268.       cmOrderWin:
  269.         begin
  270.           OpenOrderWindow;
  271.           ClearEvent(Event);
  272.         end;
  273.       cmOptionsLoad:
  274.         begin
  275.           LoadDesktop;
  276.           ClearEvent(Event);
  277.         end;
  278.       cmOptionsSave:
  279.         begin
  280.           SaveDesktop;
  281.           ClearEvent(Event);
  282.         end;
  283.       cmClipShow:
  284.         with ClipboardWindow^ do
  285.         begin
  286.           Select;
  287.           Show;
  288.           ClearEvent(Event);
  289.         end;
  290.       cmNew:
  291.         begin
  292.           NewWindow;
  293.           ClearEvent(Event);
  294.         end;
  295.       cmOpen:
  296.         begin
  297.           OpenWindow;
  298.           ClearEvent(Event);
  299.         end;
  300.       cmOptionsVideo:
  301.         begin
  302.           SetScreenMode(ScreenMode xor smFont8x8);
  303.           ClearEvent(Event);
  304.         end;
  305.       cmAbout:
  306.         begin
  307.           DoAboutBox;
  308.           ClearEvent(Event);
  309.         end;
  310.     end;
  311.   end;
  312. end;
  313.  
  314. procedure TTutorApp.InitMenuBar;
  315. begin
  316.   MenuBar := PMenuBar(ResFile.Get('MAINMENU'));
  317. end;
  318.  
  319. procedure TTutorApp.InitStatusLine;
  320. var
  321.   R: TRect;
  322. begin
  323.   StatusLine := PStatusLine(ResFile.Get('STATUS'));
  324.   GetExtent(R);
  325.   StatusLine^.MoveTo(0, R.B.Y - 1);
  326. end;
  327.  
  328. procedure TTutorApp.LoadDesktop;
  329. var
  330.   DesktopFile: TBufStream;
  331.   TempDesktop: PDesktop;
  332.   R: TRect;
  333. begin
  334.   DesktopFile.Init('DESKTOP.TUT', stOpenRead, 1024);
  335.   TempDesktop := PDesktop(DesktopFile.Get);
  336.   DesktopFile.Done;
  337.   if ValidView(TempDesktop) <> nil then
  338.   begin
  339.     Desktop^.Delete(ClipboardWindow);
  340.     Delete(Desktop);
  341.     Dispose(Desktop, Done);
  342.     Desktop := TempDesktop;
  343.     Insert(Desktop);
  344.     GetExtent(R);
  345.     R.Grow(0, -1);
  346.     Desktop^.Locate(R);
  347.     InsertWindow(ClipboardWindow);
  348.     OrderWindow := Message(Desktop, evBroadcast, cmFindOrderWindow, nil);
  349.     if OrderWindow <> nil then ShowOrder(CurrentOrder);
  350.   end;
  351. end;
  352.  
  353. procedure TTutorApp.NewWindow;
  354. var
  355.   R: TRect;
  356.   TheWindow: PEditWindow;
  357. begin
  358.   R.Assign(0, 0, 60, 20);
  359.   TheWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  360.   InsertWindow(TheWindow);
  361. end;
  362.  
  363. procedure TTutorApp.OpenOrderWindow;
  364. begin
  365.   if Message(Desktop, evBroadcast, cmFindOrderWindow, nil) = nil then
  366.   begin
  367.     OrderWindow := New(POrderWindow, Init);
  368.     InsertWindow(OrderWindow);
  369.   end
  370.   else
  371.     if PView(OrderWindow) <> Desktop^.TopView then OrderWindow^.Select;
  372.   ShowOrder(CurrentOrder);
  373.   EnableCommands([cmOrderSave]);
  374. end;
  375.  
  376. procedure TTutorApp.OpenWindow;
  377. var
  378.   R: TRect;
  379.   FileDialog: PFileDialog;
  380.   TheFile: FNameStr;
  381. const
  382.   FDOptions: Word = fdOKButton or fdOpenButton;
  383. begin
  384.   TheFile := '*.*';
  385.   New(FileDialog, Init(TheFile, 'Open file', '~F~ile name',
  386.     FDOptions, 1));
  387.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  388.   begin
  389.     R.Assign(0, 0, 75, 20);
  390.     InsertWindow(New(PEditWindow, Init(R, TheFile, wnNoNumber)));
  391.   end;
  392. end;
  393.  
  394. procedure TTutorApp.SaveDesktop;
  395. var
  396.   DesktopFile: TBufStream;
  397. begin
  398.   Desktop^.Delete(ClipboardWindow);
  399.   DesktopFile.Init('DESKTOP.TUT', stCreate, 1024);
  400.   DesktopFile.Put(Desktop);
  401.   DesktopFile.Done;
  402.   InsertWindow(ClipboardWindow);
  403. end;
  404.  
  405. procedure TTutorApp.SaveOrderData;
  406. begin
  407.   if OrderWindow^.Valid(cmClose) then
  408.   begin
  409.     OrderWindow^.GetData(OrderInfo);
  410.     POrderObj(OrderColl^.At(CurrentOrder))^.TransferRecord := OrderInfo;
  411.     SaveOrders;
  412.   end;
  413. end;
  414.  
  415. procedure TTutorApp.ShowOrder(AOrderNum: Integer);
  416. begin
  417.   OrderWindow^.SetData(OrderInfo);
  418. end;
  419.  
  420. var
  421.   TutorApp: TTutorApp;
  422.  
  423. begin
  424.   TutorApp.Init;
  425.   TutorApp.Run;
  426.   TutorApp.Done;
  427. end.
  428.